'GetCards Fragment (GetFrag.Bas)

'GetCard.Bas, extraction routines for Windows Cardfile
'from Bob Freeman, CompuServe 76214,2324
'Use at your own risk (tends to cause serious hair-pulling....)
'Please don't call me, I don't know how I wrote the program <g>
'QB3 code (and some QB7.1)
'(I started to convert it to QB7.1, but got distracted by other duties)

'This is the code to extract card data
'and put it into sorted permanent files for use by GetCards.exe

'I never have gotten around to converting it to a WinBasic format
'If you want the job, feel free to take up the torch.....
'
'You have to have your own routine to find the card name as "CARD$"
GETNAME:
        LOCATE 3
        PRINT "CARD FILE NAME is "; Card$; " with FILE SIZE="; FileSize!; " bytes"
        
OPEN "R", #1, Card$, 1
FIELD #1, 1 AS short$
        
        BtBName$ = NoHeader$            ' this sets up file for all cards....
        OPEN "R", #8, BtBName$, 42
        FIELD #8, 40 AS TempFile$, 2 AS TempLocation$

        OPEN "R", #4, Label$, 40
        FIELD #4, 40 AS BracesLABEL$
'-----------------------this finds the offset used by Cardfile------------
TempFile% = 1
FirstTime% = 0
FOR I! = 1 TO 20
GET #1, I!
IF ASC(short$) = 0 AND FirstTime% = 0 THEN FirstTime% = 1
IF FirstTime% = 1 AND ASC(short$) > 0 THEN offset = I! - 1: FirstTime% = 3
NEXT

        I! = 1
        totalcount! = 2
        A$ = ""
        TotalCard% = 0
        StartHeader% = 0
        OLDA = 0
GetHeader:
                                        'gets pointer to main  part of file
        GET #1, I! + offset             'get left half of digit
        CardName = I! + offset + 4      'save pointer to {Header}
        A$ = A$ + short$
        GET #1, I! + offset + 1         'get right half of digit
        A$ = A$ + short$
        StartCard% = CVI(A$)            'Start of Card data for later use
        A% = CVI(A$)
        SaveI! = I!
        IF I! = 1 THEN CardSize! = (FileSize! - A%)
        PreviousI! = A%
        IF A > FileSize! GOTO NoMore   'check for invalid card size
        count = 1
        Z$ = ""                         'set to empty
        FirstTime% = 0
DO
 GET #1, CardName + count
        IF ASC(short$) = 0 AND FirstTime% = 0 THEN
                LengthName = count - 1: FirstTime% = 1
        END IF
 Z$ = Z$ + short$

  count = count + 1
LOOP UNTIL count = 48 OR ASC(short$) = 13   'count to end of line or length =48
 SaveName$ = LEFT$(Z$, LengthName)
count = 0
IF A% < 1 THEN A = 65536 + CVI(A$) + 4
IF A% > 0 THEN A = ABS(CVI(A$) + 4)
Starta = A

        HEADER$ = "": OverCount% = 0
    DO                                      'this gets header name
        GET #1, A
        IF short$ = "{" THEN StartHeader% = 1   'used in GetCards, as special key

        IF ASC(short$) > 31 AND StartHeader% = 1 THEN HEADER$ = HEADER$ + short$
        A = A + 1: OverCount% = OverCount% + 1
        LOOP UNTIL ASC(short$) = 13 OR OverCount% = 40 OR A <= OLDA
        
        IF A < OLDA GOTO NoMore
        OLDA = A
        A$ = ""
NextI! = I! + 52
        '-------------------------------put in all cards--------------------
                COLOR Fore, back
                IF TempFile% < 2 THEN TempFile% = 2
                LSET TempFile$ = SaveName$
                LSET TempLocation$ = MKI$(totalcount!)'pointer to start of label..,
                PUT #8, TempFile%
                TempFile% = TempFile% + 1
        '-------------------------------put in Headline (only)----------------
        LSET MailName$ = SaveName$      'cardfile header....
PUT #2, totalcount!: StartOfCard! = totalcount!
        totalcount! = totalcount! + 1

        TotalCard% = TotalCard% + 1: ThisCount = 0

IF StartHeader% = 1 THEN         'valid header file

        '---------------------------This Checks for Multiple HEADERS---------
        ThisCount = 0             ' and makes permanent file of headers
        MATCH = 0
        FOR test% = 1 TO total
        GET #4, test%
        HEADER$ = UCASE$(HEADER$)
        BraceLabel$ = UCASE$(BracesLABEL$)
                IF BracesLABEL$ = LEFT$(HEADER$ + SPACE$(40), 40) THEN MATCH = 1
        NEXT
        IF MATCH = 0 THEN
                LSET BracesLABEL$ = HEADER$
                PUT #4, total
                total = total + 1
             END IF
 END IF

        LOCATE 4
        PRINT "Card # "; TotalCard%
        ColorFore = Fore: ColorBack = back
        Row% = 5
        Prnt$ = LEFT$("[" + SaveName$ + "]" + SPACE$(50), 50)
        GOSUB FastScreen
        Row% = 6
        Prnt$ = HEADER$
        GOSUB FastScreen
        long$ = "": count = 0: Row% = 6: COL% = 1: ColorFore = 0: ColorBack = 7
        A = Starta + 1
        GET #1, A + 1
                                                ':StartOfCard=TotalCount!-1
        DO
                IF A < 1 THEN A = 1
                GET #1, A
                IF ASC(short$) > 10 THEN long$ = long$ + short$
                IF ASC(short$) = 13 THEN
                        long$ = LEFT$(long$, (LEN(long$) - 1))
                                            'prnt$= str$(a)+LEFT$(long$+space$(50),50)'Remove
                        Row% = Row% + 1
                                           'GOSUB FastScreen  'remove
                        LSET MailName$ = long$: LSET HowMany$ = MKI$(0)
                        PUT #2, totalcount!
                        totalcount! = totalcount! + 1
                        long$ = ""
                        ThisCount = ThisCount + 1
                    END IF
                    A = A + 1
                                                                'I!=I!+1
        LOOP UNTIL ASC(short$) = 0
        IF LEN(long$) > 0 THEN
                        Row% = Row% + 1
                        LSET MailName$ = long$: LSET HowMany$ = MKI$(0)
                        PUT #2, totalcount!
                        totalcount! = totalcount! + 1
                        long$ = ""
                        ThisCount = ThisCount + 1
        END IF
                A = A + 1
        WHILE ASC(short$) = 0
                GET #1, I!
                I! = I! + 1
                        blankcount = blankcount + 1
                        IF blankcount = 1000 THEN GOTO NoMore
        WEND

blankcount = 0
COLOR 15, 0
IF LEN(long$) > 1 THEN
                LSET MailName$ = long$
                LSET HowMany$ = MKI$(0)
                PUT #2, totalcount!
                totalcount! = totalcount! + 1
                ThisCount = ThisCount + 1
                END IF
long$ = ""
IF FirstCount! < 1 THEN FirstCount! = 1
GET #2, StartOfCard: LSET HowMany$ = MKI$(ThisCount)
PUT #2, StartOfCard


FirstCount! = totalcount! + 1
I! = NextI!
GOTO GetHeader


NoMore:
        LSET MailName$ = "Number of cards is"
        LSET HowMany$ = MKI$(TotalCard%)
        PUT #2, 1
        '--------------------close header file---------------
                GET #8, 1
                LSET TempFile$ = LEFT$(SaveFile$ + SPACE$(32), 32) + SaveFile$
                LSET TempLocation$ = MKI$(TempFile% - 1)
                PUT #8, 1
                CLOSE #8
'-------------------------------------------------------------------------
        COLOR 15, 0
        LOCATE 4: PRINT "NO MORE..,                     Total Cards Found="; TotalCard%